PC World Interactive 7/PC World Interactive 7.iso/program/vbkontrol.exe/NETC_13N.ZIP/DEMO.FRM

Text File | 1995-06-14 | 13KB | 417 lines

VERSION 2.00
Begin Form Form1
   BackColor       =   &H00C0C0C0&
   Caption         =   "NetCode Demo"
   ClientHeight    =   5370
   ClientLeft      =   990
   ClientTop       =   2595
   ClientWidth     =   6090
   FillColor       =   &H00808080&
   FillStyle       =   0  'Solid
   Height          =   5775
   Icon            =   DEMO.FRX:0000
   Left            =   930
   LinkTopic       =   "Form1"
   ScaleHeight     =   5370
   ScaleWidth      =   6090
   Top             =   2250
   Width           =   6210
   Begin ComboBox Fmt
      BackColor       =   &H00E0E0E0&
      Height          =   288
      Left            =   2160
      Style           =   2  'Dropdown List
      TabIndex        =   21
      Top             =   1920
      Width           =   1692
   End
   Begin SpinButton Spin1
      BackColor       =   &H00E0FFFF&
      Height          =   252
      Left            =   5760
      SpinBackColor   =   &H00E0FFFF&
      Top             =   2400
      Width           =   252
   End
   Begin CheckBox CB_Intellicode
      BackColor       =   &H00C0C0C0&
      Caption         =   " IntelliCode"
      Height          =   372
      Left            =   4080
      TabIndex        =   18
      Top             =   3480
      Width           =   1452
   End
   Begin CheckBox CB_OverwriteFile
      BackColor       =   &H00C0C0C0&
      Caption         =   " Overwrite"
      ForeColor       =   &H00404040&
      Height          =   372
      Left            =   4080
      TabIndex        =   17
      Top             =   3840
      Width           =   1212
   End
   Begin TextBox FileName
      BackColor       =   &H00E0FFFF&
      Height          =   288
      Left            =   3360
      TabIndex        =   10
      Top             =   3000
      Width           =   2652
   End
   Begin PictureBox Picture1
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      FillColor       =   &H00C0C0C0&
      Height          =   495
      Left            =   120
      Picture         =   DEMO.FRX:0302
      ScaleHeight     =   495
      ScaleWidth      =   495
      TabIndex        =   15
      Top             =   360
      Width           =   495
   End
   Begin CommandButton DecodedFileButton
      Caption         =   "..."
      Height          =   252
      Left            =   5520
      TabIndex        =   9
      Top             =   1440
      Width           =   372
   End
   Begin CommandButton EncodedFileButton
      Caption         =   "..."
      Height          =   252
      Left            =   5520
      TabIndex        =   7
      Top             =   720
      Width           =   372
   End
   Begin TextBox DecodedData
      Height          =   732
      Left            =   1680
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   8
      Top             =   960
      Width           =   3852
   End
   Begin OptionButton OB_Enc2String
      BackColor       =   &H00E0E0E0&
      Caption         =   "EncodeToString"
      Height          =   492
      Left            =   480
      TabIndex        =   0
      Top             =   3720
      Width           =   1680
   End
   Begin OptionButton OB_Enc2File
      BackColor       =   &H00E0E0E0&
      Caption         =   "EncodeToFile"
      Height          =   372
      Left            =   480
      TabIndex        =   1
      Top             =   3360
      Width           =   1572
   End
   Begin OptionButton OB_Dec2String
      BackColor       =   &H00E0E0E0&
      Caption         =   "DecodeToString"
      Height          =   372
      Left            =   480
      TabIndex        =   2
      Top             =   2880
      Width           =   1680
   End
   Begin OptionButton OB_Dec2File
      BackColor       =   &H00E0E0E0&
      Caption         =   "DecodeToFile"
      Height          =   492
      Left            =   480
      TabIndex        =   3
      Top             =   2400
      Width           =   1572
   End
   Begin OptionButton OB_Idle
      BackColor       =   &H00E0E0E0&
      Caption         =   "Idle"
      Height          =   492
      Left            =   480
      TabIndex        =   4
      Top             =   2040
      Value           =   -1  'True
      Width           =   852
   End
   Begin Frame Frame1
      BackColor       =   &H00E0E0E0&
      Caption         =   "Action"
      Height          =   2412
      Left            =   360
      TabIndex        =   11
      Top             =   1800
      Width           =   1812
      Begin Line Line1
         X1              =   0
         X2              =   2280
         Y1              =   1510
         Y2              =   1510
      End
   End
   Begin TextBox EncodedData
      Height          =   732
      Left            =   1680
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   6
      Top             =   240
      Width           =   3852
   End
   Begin Gauge Gauge1
      Autosize        =   -1  'True
      BackColor       =   &H00FFC0C0&
      ForeColor       =   &H00C00000&
      Height          =   492
      InnerBottom     =   5
      InnerLeft       =   5
      InnerRight      =   5
      InnerTop        =   5
      Left            =   240
      Max             =   100
      NeedleWidth     =   1
      TabIndex        =   13
      Top             =   4680
      Width           =   5652
   End
   Begin NetCode NetCode1
      IntelliCode     =   -1  'True
      Left            =   0
      MaxFileSize     =   0
      Overwrite       =   -1  'True
      ProgressStep    =   1
      Top             =   0
   End
   Begin Label FileCnt
      BackColor       =   &H00C0C0C0&
      Height          =   252
      Left            =   2760
      TabIndex        =   20
      Top             =   3840
      Width           =   972
   End
   Begin Label L_MaxFSize
      Alignment       =   1  'Right Justify
      BackColor       =   &H00C0C0C0&
      Caption         =   "Maximum filesize"
      Height          =   252
      Left            =   3360
      TabIndex        =   19
      Top             =   2400
      Width           =   2292
   End
   Begin Label Label4
      BackColor       =   &H00C0C0C0&
      Caption         =   "Filename"
      Height          =   252
      Left            =   3360
      TabIndex        =   12
      Top             =   2760
      Width           =   1092
   End
   Begin Label Done
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "% Done"
      Height          =   252
      Left            =   2400
      TabIndex        =   14
      Top             =   4320
      Width           =   1332
   End
   Begin Label Label2
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Encoded"
      Height          =   252
      Left            =   600
      TabIndex        =   5
      Top             =   360
      Width           =   1092
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BackColor       =   &H00C0C0C0&
      Caption         =   "Decoded"
      Height          =   252
      Left            =   600
      TabIndex        =   16
      Top             =   1080
      Width           =   1092
   End
End
Option Explicit
Dim Overwrite%, IntelliCode%, MaxFileSize&

Const IDLE = 0
Const DecodeToFile = 1
Const EncodeToFile = 2
Const DecodeToString = 3
Const EncodeToString = 4

Const UUEncode = 0
Const Base64 = 1
Const Quoted_Printable = 2

Const UNCHECKED = 0
Const CHECKED = 1

Const VBERR_OUT_OF_MEMORY = 7
Const VBERR_BAD_PROPERTY_VALUE = 380  ' // Index of error message for 'Invalid property value.'
Const VBERR_BAD_ARRAY_INDEX = 381    ' // Index of property array out of bounds.
Const VBERR_PROPERTY_READ_ONLY = 383
Const VBERR_PROPERTY_WRITE_ONLY = 394

Const NCERR_BEGIN_NOT_FOUND = 20001
Const NCERR_SHORT_FILE = 20002      'uudecode...
Const NCERR_NO_END = 20003            'uudecode didn't find the closing "end"
Const NCERR_FILE_CREATE = 20004 'can't create for write (write protected ?)
Const NCERR_FILE_OPEN = 20005  'can't open for read (doesn't exist?)
Const NCERR_FILE_READ = 20006 'can't read from file
Const NCERR_FILE_WRITE = 20007 'can't write to file (disk full?)
Const NCERR_NO_FILENAME = 20008 'no filename given
Const NCERR_FILE_EXISTS = 20009 'File exists and 'Overwrite' was On
Const NCERR_NOT_ENOUGH_SPACE_IN_STRING = 20010 'the given pointer had not enought space to contain the output
Const NCERR_NO_ENC_FILE = 20012 'No filename was given where to write the encoded data
Const NCERR_NO_SUCH_FILENAME = 20017 'No such filename
Const NCERR_NO_MORE_FILES = 20018 'No more files where to read from or write to

Sub CB_Intellicode_Click ()
  IntelliCode% = CB_Intellicode.Value
  NetCode1.IntelliCode = IntelliCode%
End Sub

Sub CB_OverwriteFile_Click ()
  Overwrite% = CB_OverwriteFile.Value '2=grayed not treated
  NetCode1.Overwrite = Overwrite%
End Sub

Sub DoAction (Action As Integer)
  On Error GoTo ErrorHandler
  NetCode1.EncodedData = Form1.EncodedData
  NetCode1.DecodedData = Form1.DecodedData
  NetCode1.FileName = Form1.FileName
  NetCode1.MaxFileSize = MaxFileSize&
  NetCode1.Action = Action
  Form1.FileName = NetCode1.FileName
  Form1.DecodedData = NetCode1.DecodedData
  Form1.EncodedData = NetCode1.EncodedData
  If (NetCode1.FileCnt) Then
    Form1.FileCnt.Caption = 1 + NetCode1.FileCnt & " Files"
  Else
    Form1.FileCnt.Caption = ""
  End If
  OB_Idle.Value = True
  Exit Sub
ErrorHandler:
  Dim Msg As String
  Select Case Err
    Case VBERR_OUT_OF_MEMORY: Msg = "Out of memory"
    Case VBERR_BAD_PROPERTY_VALUE: Msg = "Invalid property value"
    Case VBERR_BAD_ARRAY_INDEX: Msg = "Index of property array out of bounds"
    Case VBERR_PROPERTY_READ_ONLY: Msg = "Property read-only"
    Case VBERR_PROPERTY_WRITE_ONLY: Msg = "Property write-only"

    Case NCERR_BEGIN_NOT_FOUND: Msg = "The starting ""begin "" was not found"
    Case NCERR_SHORT_FILE: Msg = "The input ended unexpectedly"
    Case NCERR_NO_END: Msg = "The closing ""end"" was not found (uudecoded file may be too short)"
    Case NCERR_FILE_CREATE: Msg = "Can't create a file (illegal filename or disk is write-protected)"
    Case NCERR_FILE_OPEN: Msg = "Can't open for read the input file (file doesn't exist?)"
    Case NCERR_FILE_READ: Msg = "Can't read from input file"
    Case NCERR_FILE_WRITE: Msg = "Can't write to file (disk full?)"
    Case NCERR_NO_FILENAME: Msg = "No filename was given while encoding"
    Case NCERR_FILE_EXISTS: Msg = "File exists and Overwrite was set to FALSE"
    Case NCERR_NOT_ENOUGH_SPACE_IN_STRING: Msg = "The given pointer had not enought space to contain the output (only when using the exported functions)"
    Case NCERR_NO_ENC_FILE: Msg = "No filename was given where to write the encoded data"
    Case NCERR_NO_SUCH_FILENAME: Msg = "No such filename"
    Case NCERR_NO_MORE_FILES: Msg = "No more files where to read from or write to"

    Case Else: Msg = "ERROR " & Err & " occurred."
  End Select
  MsgBox Msg  ' Display error message.
  Resume Next ' Resume procedure.
End Sub

Sub Fmt_Click ()
  NetCode1.Format = Fmt.ListIndex
End Sub

Sub Form_Load ()
  If NetCode1.Overwrite Then
    CB_OverwriteFile.Value = CHECKED
  Else
    CB_OverwriteFile.Value = UNCHECKED
  End If
  Overwrite% = CB_OverwriteFile.Value
  IntelliCode% = True
  NetCode1.IntelliCode = True
  CB_Intellicode.Value = CHECKED
  MaxFileSize& = (NetCode1.MaxFileSize + 100) / 200
  MaxFileSize& = MaxFileSize& * 200
  NetCode1.MaxFileSize = MaxFileSize&
  L_MaxFSize.Caption = "Maximum filesize " & Str$(MaxFileSize&)
  Fmt.AddItem "UUEncode", UUEncode
  Fmt.AddItem "Base64", Base64
  Fmt.AddItem "Quoted Printable", Quoted_Printable
  Fmt.ListIndex = NetCode1.Format
End Sub

Sub NetCode1_Progress (PercentDone As Integer)
   Gauge1.Value = PercentDone
   Done.Caption = PercentDone & "% Done"
   DoEvents
End Sub

Sub OB_Dec2File_Click ()
  If NetCode1.Action = IDLE Then
    DoAction (DecodeToFile)
  End If
End Sub

Sub OB_Dec2String_Click ()
  If NetCode1.Action = IDLE Then
    DoAction (DecodeToString)
  End If
End Sub

Sub OB_Enc2File_Click ()
  If NetCode1.Action = IDLE Then
    DoAction (EncodeToFile)
  End If
End Sub

Sub OB_Enc2String_Click ()
  If NetCode1.Action = IDLE Then
    DoAction (EncodeToString)
  End If
End Sub

Sub OB_Idle_Click ()
  NetCode1.Action = IDLE
End Sub

Sub Spin1_SpinDown ()
  If MaxFileSize& >= 10000 Then
    MaxFileSize& = MaxFileSize& - 10000
    L_MaxFSize.Caption = "Maximum filesize " & Str$(MaxFileSize&)
  End If
End Sub

Sub Spin1_SpinUp ()
  If MaxFileSize& < 2 ^ 31 - 10000 Then
    MaxFileSize& = MaxFileSize& + 10000
    L_MaxFSize.Caption = "Maximum filesize " & Str$(MaxFileSize&)
  End If
End Sub